Ian & Stuart's Australian Mac 1993 September/September 93.iso/Archives/Games/Strategy/Puzzle/GameMaster/GM Dev Kit/Rulebook Sources/TicTacToe/TicTacToe.p

Text File | 1991-12-05 | 9.4 KB | 386 lines | [TEXT/PJMM]

unit TicTacToe;

{ ©1991 Quinn "The Eskimo" }

interface

    uses
        QuickDrawRules, {}
        GameTypes, {}
        NumSubs, Failure, Debugs, DialogSubs;

    procedure Main (var gameevent: gameEventRecord);

implementation

    const
        rIconBase = 1000;
        rStrokeBase = 1100;
        rMainDialog = 1000;
        dit_stroke = 15;

    type
        xNdx = 1..3;
        yNdx = 1..3;

        cellType = (Cempty, Coh, Cex);
        playerType = (Poh, Pex);
        playStateType = (ps_Playing, ps_GameOver);
        connectionStateType = (cs_Local, cs_Remote);
        strokeStateType = (horiz, vert, leftdiag, rightdiag);
        boardType = array[xNdx, yNdx] of cellType;

        globalsRecord = record
                icons: array[cellType] of handle;
                strokes: array[strokeStateType] of PicHandle;
            end;
        globalsPtr = ^globalsRecord;
        globalsPeek = ^globalsPtr;


        gameRecord = record
                globals: globalsPeek;
                connectionstate: connectionStateType;
                playertomove: playerType;
                localplayer: playerType;
                playstate: playStateType;
                board: boardType;
                moved: set of 1..9;
                strokestate: strokeStateType;
                strokendx: integer;
            end;
        gamePtr = ^gameRecord;
        gamePeek = ^gamePtr;

    procedure StrokeUserItem (dlg: DialogPtr; itemNo: integer);
        var
            r, myrect: rect;
            pic: PicHandle;
            gp: gamePeek;
    begin
        gp := gamePeek(WindowPeek(dlg)^.refcon);
        if gp^^.playstate = ps_GameOver then begin
            GetDRect(dlg, itemNo, r);
            pic := gp^^.globals^^.strokes[gp^^.strokestate];
            myrect := pic^^.picFrame;
            OffsetRect(myrect, -myrect.left, -myrect.top);
            OffsetRect(myrect, r.left, r.top);
            case gp^^.strokestate of
                horiz:
                    OffsetRect(myrect, 0, (gp^^.strokendx - 1) * 33 - 3);
                vert:
                    OffsetRect(myrect, (gp^^.strokendx - 1) * 33, 0);
                otherwise
            end; { case }
            DrawPicture(pic, myrect);
        end; { if }
    end; { StrokeUserItem }

    procedure Main (var gameevent: gameEventRecord);

        procedure InitRuleBook;
            var
                gp: globalsPeek;
                c: cellType;
                rh: DialogTHndl;
                s: strokeStateType;
        begin
            gameevent.globals := NewHandle(sizeof(globalsRecord));
            HLock(gameevent.globals);
            gp := globalsPeek(gameevent.globals);
            for c := Cempty to Cex do begin
                gp^^.icons[c] := GetIcon(rIconBase + ord(c));
                FailNil(gp^^.icons[c], 'Icon not found');
                FailResError('Icon error');
            end; { for }
            for s := horiz to rightdiag do begin
                gp^^.strokes[s] := GetPicture(ord(s) + rStrokeBase);
                FailNil(gp^^.strokes[s], 'stroke missing');
                FailResError('stroke error');
            end; { for }
            rh := DialogTHndl(GetResource('DLOG', rMainDialog));
            FailNil(rh, 'Dialog not found');
            FailResError('Dialog error');
            gameevent.int1 := rh^^.boundsRect.right - rh^^.boundsRect.left;
            gameevent.int2 := rh^^.boundsRect.bottom - rh^^.boundsRect.left;
            ReleaseResource(Handle(rh));
            HUnlock(gameevent.globals);
        end; { InitRuleBook }

        procedure FinishRuleBook;
        begin
            DisposeHandle(gameevent.globals);
            gameevent.globals := nil;
{ Dont release resources as the resource file will be closed (hopefully) }
        end; { FinishRuleBook }

        function Opposite (p: playerType): playerType;
        begin
            case p of
                Poh:
                    Opposite := Pex;
                Pex:
                    Opposite := Poh;
            end; { case }
        end; { Opposite }

        procedure PseudoMain (var game: gameRecord; var globals: globalsRecord);

            procedure PlacePiece (p: playerType; x: xNdx; y: yNdx);
                var
                    c: cellType;
                    r: Rect;
                    dit: integer;
            begin
                case p of
                    Pex:
                        c := Cex;
                    Poh:
                        c := Coh;
                end; { case }
                game.board[x, y] := c;
                dit := (x - 1) * 3 + y;
                SetDHandle(QDGlobals^.thePort, dit, globals.icons[c]);
                GetDRect(QDGlobals^.thePort, dit, r);
                InvalRect(r);
                game.moved := game.moved + [dit];
            end; { PlacePiece }

            procedure MoveComplete;

                function GameOver: boolean;
                    var
                        res: boolean;
                    procedure CheckLine (x1, y1, x2, y2, x3, y3: integer; ss: strokeStateType; sn: integer);
                    begin
                        if not res and ((game.board[x1, y1] <> Cempty) and (game.board[x1, y1] = game.board[x2, y2]) and (game.board[x2, y2] = game.board[x3, y3])) then begin
                            res := true;
                            game.strokestate := ss;
                            game.strokendx := sn;
                        end; { if }
                    end; { CheckLine }
                begin
                    res := false;
                    CheckLine(1, 1, 1, 2, 1, 3, vert, 1);
                    CheckLine(2, 1, 2, 2, 2, 3, vert, 2);
                    CheckLine(3, 1, 3, 2, 3, 3, vert, 3);

                    CheckLine(1, 1, 2, 1, 3, 1, horiz, 1);
                    CheckLine(1, 2, 2, 2, 3, 2, horiz, 2);
                    CheckLine(1, 3, 2, 3, 3, 3, horiz, 3);

                    CheckLine(1, 1, 2, 2, 3, 3, leftdiag, 0);
                    CheckLine(3, 1, 2, 2, 1, 3, rightdiag, 0);
                    GameOver := res;
                end; { GameOver }
                var
                    r: Rect;
            begin
                game.playertomove := Opposite(game.playertomove);
                if GameOver then begin
                    game.playstate := ps_GameOver;
                    GetDRect(QDGlobals^.thePort, dit_stroke, r);
                    InvalRect(r);
                end; { if }
            end; { MoveComplete }

            procedure UpdateStatus;
            begin
                case game.connectionstate of
                    cs_Local:
                        gameevent.myturn := true;
                    cs_Remote:
                        gameevent.myturn := (game.playertomove = game.localplayer);
                end; { case }
            end; { UpdateStatus }

            procedure CommonInit;
            begin
                SetDHandle(QDGlobals^.thePort, dit_stroke, @StrokeUserItem);
                SetWRefCon(QDGlobals^.thePort, longint(gameevent.game));
                game.globals := globalsPeek(gameevent.globals);
            end; { CommonInit }

            procedure ClearGameState;
                var
                    x: xNdx;
                    y: yNdx;
            begin
                for x := 1 to 3 do begin
                    for y := 1 to 3 do begin
                        game.board[x, y] := Cempty;
                    end; { for }
                end; { for }
                game.playstate := ps_Playing;
                game.playertomove := Pex;
                game.moved := [];
            end; { ClearGameState }

            procedure ChangeHandles;
                var
                    x: xNdx;
                    y: yNdx;
                    dit: integer;
            begin
                for x := 1 to 3 do begin
                    for y := 1 to 3 do begin
                        dit := (x - 1) * 3 + y;
                        SetDHandle(QDGlobals^.thePort, dit, globals.icons[game.board[x, y]]);
                    end; { for }
                end; { for }
            end; { ChangeHandles }

            procedure NewGame;
            begin
                CommonInit;
                ClearGameState;
                ChangeHandles;
                game.localplayer := Pex;
                game.connectionstate := cs_Local;
            end; { NewGame }

            procedure OldGame;
            begin
                CommonInit;
                ChangeHandles;
                game.connectionstate := cs_Local;
            end; { OldGame }

            procedure Swap;
            begin
                game.localplayer := Opposite(game.localplayer);
            end; { Swap }

            procedure Restart;
            begin
                ClearGameState;
                ChangeHandles;
                InvalRect(QDGlobals^.thePort^.portRect);
            end; { Restart }

            procedure ConnectionMade;
            begin
                game.connectionstate := cs_Remote;
                UpdateStatus;
            end; { ConnectionMade }

            procedure ConnectionLost;
            begin
                game.connectionstate := cs_Local;
                UpdateStatus;
            end; { ConnectionLost }

            procedure MessageReceived;
                var
                    x: xNdx;
                    y: yNdx;
            begin
                if game.connectionstate <> cs_Remote then begin
                    Failure('Message while not connected');
                end
                else if Length(gameevent.message) <> 2 then begin
                    Failure('Message not the right length');
                end
                else begin
                    x := ord(gameevent.message[1]) - ord('0');
                    y := ord(gameevent.message[2]) - ord('0');
                    PlacePiece(game.playertomove, x, y);
                    MoveComplete;
                    UpdateStatus;
                end;
            end; { MessageReceived }

            procedure SendMove (x: xNdx; y: yNdx);
            begin
                gameevent.message := concat(chr(x + ord('0')), chr(y + ord('0')));
                gameevent.event := ge_SendMessage;
            end; { SendMove }

            procedure MouseDown;

                function TrackMouse (x: xNdx; y: yNdx): boolean;
                    var
                        r: Rect;
                        mouse: Point;
                        inside, inverted: boolean;
                begin
                    GetDRect(QDGlobals^.thePort, gameevent.int1, r);
                    inverted := false;
                    while StillDown do begin
                        GetMouse(mouse);
                        inside := PtInRect(mouse, r);
                        if (inside and not inverted) or (inverted and not inside) then begin
                            inverted := not inverted;
                            InvertRect(r);
                        end; { if }
                    end; { while }
                    if inverted then begin
                        InvertRect(r);
                    end; { if }
                    TrackMouse := inside;
                end; { TrackMouse }

                var
                    x: xNdx;
                    y: yNdx;
            begin
                if not (gameevent.int1 in game.moved) and (game.playstate = ps_Playing) then begin
                    x := (gameevent.int1 - 1) div 3 + 1;
                    y := (gameevent.int1 - 1) mod 3 + 1;
                    if TrackMouse(x, y) then begin
                        PlacePiece(game.playertomove, x, y);
                        if game.connectionstate = cs_Remote then begin
                            SendMove(x, y);
                        end; { if }
                        MoveComplete;
                        UpdateStatus;
                    end; { if }
                end; { if }
            end; { MouseDown }

        begin { PseudoMain }
            case gameevent.event of
                ge_NewGame:
                    NewGame;
                ge_OldGame:
                    OldGame;
                ge_Swap:
                    Swap;
                ge_Restart:
                    Restart;
                ge_ConnectionLost:
                    ConnectionLost;
                ge_ConnectionMade:
                    ConnectionMade;
                ge_MessageReceived:
                    MessageReceived;
                ge_MouseDown:
                    MouseDown;
                otherwise
            end; { case }
        end; { PseudoMain }

        var
            s1, s2: SignedByte;
    begin { Main }
        case gameevent.event of
            ge_InitRuleBook:
                InitRuleBook;
            ge_FinishRuleBook:
                FinishRuleBook;
            otherwise begin
                if gameevent.event = ge_NewGame then begin
                    SetHandleSize(gameevent.game, sizeof(gameRecord));
                end; (* if *)
                s1 := HGetState(gameevent.game);
                HLock(gameevent.game);
                s2 := HGetState(gameevent.globals);
                HLock(gameevent.globals);
                PseudoMain(gamePeek(gameevent.game)^^, globalsPeek(gameevent.globals)^^);
                HSetState(gameevent.game, s1);
                HSetState(gameevent.globals, s2);
            end; (* otherwise *)
        end; (* case *)
    end; { Main }

end. { TicTacToe }